home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.004 / xemacs-1 / xemacs-19.13 / src / sound.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-08-18  |  15.0 KB  |  550 lines
  1. /* Sound functions.
  2.    Copyright (C) 1992, 1993, 1994 Jamie Zawinski.
  3.    Copyright (C) 1994, 1995 Amdahl Corporation.
  4.  
  5. This file is part of XEmacs.
  6.  
  7. XEmacs is free software; you can redistribute it and/or modify it
  8. under the terms of the GNU General Public License as published by the
  9. Free Software Foundation; either version 2, or (at your option) any
  10. later version.
  11.  
  12. XEmacs is distributed in the hope that it will be useful, but WITHOUT
  13. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  14. FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  15. for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with XEmacs; see the file COPYING.  If not, write to the Free
  19. Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  20.  
  21. /* Synched up with: Not in FSF. */
  22.  
  23. /* Originally written by Jamie Zawinski.
  24.    Hacked on quite a bit by various others. */
  25.  
  26. #include <config.h>
  27. #include "lisp.h"
  28.  
  29. #ifdef HAVE_X_WINDOWS
  30. #include "device-x.h"
  31. #endif
  32.  
  33. #ifdef HAVE_NEXTSTEP
  34. #include "device-ns.h"
  35. #endif
  36.  
  37. #include "commands.h"
  38. #include "device.h"
  39. #include "redisplay.h"
  40. #include "sysdep.h"
  41.  
  42. #ifdef HAVE_NATIVE_SOUND
  43. # include <netdb.h>
  44. #endif
  45.  
  46. int bell_volume;
  47. Lisp_Object Vsound_alist;
  48. Lisp_Object Vsynchronous_sounds;
  49. Lisp_Object Vnative_sound_only_on_console;
  50. Lisp_Object Q_volume, Q_pitch, Q_duration, Q_sound;
  51.  
  52. /* These are defined in the appropriate file (sunplay.c, sgiplay.c,
  53.    or hpplay.c). */
  54.  
  55. extern void play_sound_file (char *name, int volume);
  56. extern void play_sound_data (unsigned char *data, int length, int volume);
  57.  
  58. #ifdef HAVE_NAS_SOUND
  59. extern int nas_play_sound_file (char *name, int volume);
  60. extern int nas_play_sound_data (unsigned char *data, int length, int volume);
  61. extern int nas_wait_for_sounds (void);
  62. extern char *nas_init_play (Display *);
  63.  
  64. Lisp_Object Qnas;
  65. #endif
  66.  
  67. DEFUN ("play-sound-file", Fplay_sound_file, Splay_sound_file,
  68.        1, 3, "fSound file name: ",
  69.  "Play the named sound file on DEVICE's speaker at the specified volume\n\
  70. (0-100, default specified by the `bell-volume' variable).\n\
  71. The sound file must be in the Sun/NeXT U-LAW format.\n\
  72.   DEVICE defaults to the selected device.")
  73.      (file, volume, device)
  74.    Lisp_Object file, volume, device;
  75. {
  76.   /* This function can GC */
  77.   int vol;
  78. #if defined (HAVE_NATIVE_SOUND) || defined (HAVE_NAS_SOUND)
  79.   struct device *d = get_device (device);
  80. #endif
  81.   CHECK_STRING (file, 0);
  82.   if (NILP (volume))
  83.     vol = bell_volume;
  84.   else
  85.     {
  86.       CHECK_INT (volume, 0);
  87.       vol = XINT (volume);
  88.     }
  89.  
  90.   file = Fexpand_file_name (file, Qnil);
  91.   if (NILP (Ffile_readable_p (file)))
  92.     if (NILP (Ffile_exists_p (file)))
  93.       error ("file does not exist.");
  94.     else
  95.       error ("file is unreadable.");
  96.  
  97. #ifdef HAVE_NAS_SOUND
  98.   if (DEVICE_CONNECTED_TO_NAS_P (d) &&
  99.       /* #### NAS code should allow specification of a device. */
  100.       nas_play_sound_file (string_ext_data (XSTRING (file)), vol))
  101.     return Qnil;
  102. #endif /* HAVE_NAS_SOUND */
  103.  
  104. #ifdef HAVE_NATIVE_SOUND
  105.   if (NILP (Vnative_sound_only_on_console) || DEVICE_ON_CONSOLE_P (d))
  106.     {
  107.       /* The sound code doesn't like getting SIGIO interrupts.
  108.      Unix sucks! */
  109.       stop_interrupts ();
  110.       play_sound_file (string_ext_data (XSTRING (file)), vol);
  111.       start_interrupts ();
  112.       QUIT;
  113.     }
  114. #endif /* HAVE_NATIVE_SOUND */
  115.  
  116.   return Qnil;
  117. }
  118.  
  119. static void
  120. parse_sound_alist_elt (Lisp_Object elt,
  121.                Lisp_Object *volume,
  122.                Lisp_Object *pitch,
  123.                Lisp_Object *duration,
  124.                Lisp_Object *sound)
  125. {
  126.   *volume = Qnil;
  127.   *pitch = Qnil;
  128.   *duration = Qnil;
  129.   *sound = Qnil;
  130.   if (! CONSP (elt))
  131.     return;
  132.  
  133.   /* The things we do for backward compatibility...
  134.      I wish I had just forced this to be a plist to begin with.
  135.    */
  136.  
  137.   if (SYMBOLP (elt) || STRINGP (elt))        /* ( name . <sound> ) */
  138.     {
  139.       *sound = elt;
  140.     }
  141.   else if (!CONSP (elt))
  142.     {
  143.       return;
  144.     }
  145.   else if (NILP (XCDR (elt)) &&        /* ( name <sound> ) */
  146.        (SYMBOLP (XCAR (elt)) ||
  147.         STRINGP (XCAR (elt))))
  148.     {
  149.       *sound = XCAR (elt);
  150.     }
  151.   else if (INT_OR_FLOATP (XCAR (elt)) &&    /* ( name <vol> . <sound> ) */
  152.        (SYMBOLP (XCDR (elt)) ||
  153.         STRINGP (XCDR (elt))))
  154.     {
  155.       *volume = XCAR (elt);
  156.       *sound = XCDR (elt);
  157.     }
  158.   else if (INT_OR_FLOATP (XCAR (elt)) &&    /* ( name <vol> <sound> ) */
  159.        CONSP (XCDR (elt)) &&
  160.        NILP (XCDR (XCDR (elt))) &&
  161.        (SYMBOLP (XCAR (XCDR (elt))) ||
  162.         STRINGP (XCAR (XCDR (elt)))))
  163.     {
  164.       *volume = XCAR (elt);
  165.       *sound = XCAR (XCDR (elt));
  166.     }
  167.   else if ((SYMBOLP (XCAR (elt)) ||    /* ( name <sound> . <vol> ) */
  168.         STRINGP (XCAR (elt))) &&
  169.        INT_OR_FLOATP (XCDR (elt)))
  170.     {
  171.       *sound = XCAR (elt);
  172.       *volume = XCDR (elt);
  173.     }
  174. #if 0 /* this one is ambiguous with the plist form */
  175.   else if ((SYMBOLP (XCAR (elt)) ||    /* ( name <sound> <vol> ) */
  176.         STRINGP (XCAR (elt))) &&
  177.        CONSP (XCDR (elt)) &&
  178.        NILP (XCDR (XCDR (elt))) &&
  179.        INT_OR_FLOATP (XCAR (XCDR (elt))))
  180.     {
  181.       *sound = XCAR (elt);
  182.       *volume = XCAR (XCDR (elt));
  183.     }
  184. #endif /* 0 */
  185.   else                    /* ( name [ keyword <value> ]* ) */
  186.     {
  187.       while (CONSP (elt))
  188.     {
  189.       Lisp_Object key, val;
  190.       key = XCAR (elt);
  191.       val = XCDR (elt);
  192.       if (!CONSP (val))
  193.         return;
  194.       elt = XCDR (val);
  195.       val = XCAR (val);
  196.       if (EQ (key, Q_volume))
  197.         {
  198.           if (INT_OR_FLOATP (val)) *volume = val;
  199.         }
  200.       else if (EQ (key, Q_pitch))
  201.         {
  202.           if (INT_OR_FLOATP (val)) *pitch = val;
  203.           if (NILP (*sound)) *sound = Qt;
  204.         }
  205.       else if (EQ (key, Q_duration))
  206.         {
  207.           if (INT_OR_FLOATP (val)) *duration = val;
  208.           if (NILP (*sound)) *sound = Qt;
  209.         }
  210.       else if (EQ (key, Q_sound))
  211.         {
  212.           if (SYMBOLP (val) || STRINGP (val)) *sound = val;
  213.         }
  214.     }
  215.     }
  216. }
  217.  
  218. DEFUN ("play-sound", Fplay_sound, Splay_sound, 1, 3, 0,
  219.        "Play a sound of the provided type.\n\
  220. See the variable `sound-alist'.")
  221.      (sound, volume, device)
  222.      Lisp_Object sound, volume, device;
  223. {
  224.   int looking_for_default = 0;
  225.   /* variable `sound' is anything that can be a cdr in sound-alist */
  226.   Lisp_Object new_volume, pitch, duration, data;
  227.   int loop_count = 0;
  228.   int vol, pit, dur;
  229.   struct device *d = get_device (device);
  230.  
  231.   /* NOTE!  You'd better not signal an error in here. */
  232.  
  233.  
  234.  try_it_again:
  235.   while (1)
  236.     {
  237.       if (SYMBOLP (sound))
  238.     sound = Fcdr (Fassq (sound, Vsound_alist));
  239.       parse_sound_alist_elt (sound, &new_volume, &pitch, &duration, &data);
  240.       sound = data;
  241.       if (NILP (volume)) volume = new_volume;
  242.       if (EQ (sound, Qt) || EQ (sound, Qnil) || STRINGP (sound))
  243.     break;
  244.       if (loop_count++ > 500)    /* much bogosity has occurred */
  245.     break;
  246.     }
  247.  
  248.   if (NILP (sound) && !looking_for_default)
  249.     {
  250.       looking_for_default = 1;
  251.       loop_count = 0;
  252.       sound = Qdefault;
  253.       goto try_it_again;
  254.     }
  255.  
  256.   
  257.   vol = (INT_OR_FLOATP (volume) ? XFLOATINT (volume) : bell_volume);
  258.   pit = (INT_OR_FLOATP (pitch) ? XFLOATINT (pitch) : -1);
  259.   dur = (INT_OR_FLOATP (duration) ? XFLOATINT (duration) : -1);
  260.  
  261.   /* If the sound is a string, and we're connected to Nas, do that.
  262.      Else if the sound is a string, and we're on console, play it natively.
  263.      Else just beep.
  264.    */
  265. #ifdef HAVE_NAS_SOUND
  266.   if (DEVICE_CONNECTED_TO_NAS_P (d) && STRINGP (sound) &&
  267.       nas_play_sound_data (string_ext_data (XSTRING (sound)), 
  268.                string_ext_length (XSTRING (sound)),
  269.                vol))
  270.     return Qnil;
  271. #endif /* HAVE_NAS_SOUND */
  272.  
  273. #ifdef HAVE_NATIVE_SOUND
  274.   if ((NILP (Vnative_sound_only_on_console) || DEVICE_ON_CONSOLE_P (d))
  275.       && STRINGP (sound))
  276.     {
  277.       /* The sound code doesn't like getting SIGIO interrupts. Unix sucks! */
  278.       stop_interrupts ();
  279.       play_sound_data ((unsigned char *) string_ext_data (XSTRING (sound)),
  280.                string_ext_length (XSTRING (sound)),
  281.                vol);
  282.       start_interrupts ();
  283.       QUIT;
  284.       return Qnil;
  285.     }
  286. #endif  /* HAVE_NATIVE_SOUND */
  287.  
  288.   DEVMETH (d, ring_bell, (d, vol, pit, dur));
  289.   return Qnil;
  290. }
  291.  
  292. DEFUN ("ding", Fding, Sding, 0, 3, 0,
  293.   "Beep, or flash the frame.\n\
  294. Also, unless an argument is given,\n\
  295. terminate any keyboard macro currently executing.\n\
  296. When called from lisp, the second argument is what sound to make, and\n\
  297. the third argument is the device to make it in (defaults to the selected\n\
  298. device).")
  299.   (arg, sound, device)
  300.   Lisp_Object arg, sound, device;
  301. {
  302.   struct device *d = get_device (device);
  303.  
  304.   XSETDEVICE (device, d);
  305.   if (NILP (arg) && !NILP (Vexecuting_macro))
  306.     /* Stop executing a keyboard macro. */
  307.     error ("Keyboard macro terminated by a command ringing the bell");
  308.   else if (visible_bell && DEVMETH (d, flash, (d)))
  309.     ;
  310.   else
  311.     Fplay_sound (sound, Qnil, device);
  312.  
  313.   return Qnil;
  314. }
  315.  
  316. DEFUN ("wait-for-sounds", Fwait_for_sounds, Swait_for_sounds,
  317.        0, 1, NULL,
  318.        "Wait for all sounds to finish playing on DEVICE.")
  319.   (device)
  320.      Lisp_Object device;
  321.  
  322. {
  323. #ifdef HAVE_NAS_SOUND
  324.   struct device *d = get_device (device);
  325.   if (DEVICE_CONNECTED_TO_NAS_P (d))
  326.     {
  327.       /* #### somebody fix this to be device-dependent. */
  328.       nas_wait_for_sounds ();
  329.     }
  330. #endif
  331.   return Qnil;
  332. }
  333.  
  334. DEFUN ("connected-to-nas-p", Fconnected_to_nas_p, Sconnected_to_nas_p,
  335.        0, 1, NULL,
  336.        "t if connected to NAS server for sounds on DEVICE.")
  337.      (device)
  338.      Lisp_Object device;
  339. {
  340. #ifdef HAVE_NAS_SOUND
  341.   struct device *d = get_device (device);
  342.   if (DEVICE_CONNECTED_TO_NAS_P (d))
  343.     return Qt;
  344.   else
  345.     return Qnil;
  346. #else
  347.   return Qnil;
  348. #endif
  349. }
  350. #ifdef HAVE_NAS_SOUND
  351.  
  352. static void
  353. init_nas_sound (struct device *d)
  354. {
  355.   char *error;
  356.  
  357. #ifdef HAVE_X_WINDOWS
  358.   if (DEVICE_IS_X (d))
  359.     {
  360.       error = nas_init_play (DEVICE_X_DISPLAY (d));
  361.       DEVICE_CONNECTED_TO_NAS_P (d) = !error;
  362.       /* Print out the message? */
  363.     }
  364. #endif /* HAVE_X_WINDOWS */
  365. }
  366.  
  367. #endif /* HAVE_NAS_SOUND */
  368.  
  369. #ifdef HAVE_NATIVE_SOUND
  370.  
  371. static void
  372. init_native_sound (struct device *d)
  373. {
  374.   if (DEVICE_IS_TTY (d) || DEVICE_IS_STREAM (d))
  375.     DEVICE_ON_CONSOLE_P (d) = 1;
  376. #ifdef HAVE_X_WINDOWS
  377.   else
  378.     {
  379.       /* When running on a machine with native sound support, we cannot use
  380.      digitized sounds as beeps unless emacs is running on the same machine
  381.      that $DISPLAY points to, and $DISPLAY points to frame 0 of that
  382.      machine.
  383.      */
  384.  
  385.       Display *display = DEVICE_X_DISPLAY (d);
  386.       char *dpy = DisplayString (display);
  387.       char *tail = (char *) strchr (dpy, ':');
  388.       if (! tail ||
  389.       strncmp (tail, ":0", 2))
  390.     DEVICE_ON_CONSOLE_P (d) = 0;
  391.       else
  392.     {
  393.       char dpyname[255], localname[255];
  394.  
  395.       /* some systems can't handle SIGIO or SIGALARM in gethostbyname. */
  396.       stop_interrupts ();
  397.       strncpy (dpyname, dpy, tail-dpy);
  398.       dpyname [tail-dpy] = 0;
  399.       if (!*dpyname ||
  400.           !strcmp (dpyname, "unix") ||
  401.           !strcmp (dpyname, "localhost"))
  402.         DEVICE_ON_CONSOLE_P (d) = 1;
  403.       else if (gethostname (localname, sizeof (localname)))
  404.         DEVICE_ON_CONSOLE_P (d) = 0;    /* can't find hostname? */
  405.       else
  406.         {
  407.           /* We have to call gethostbyname() on the result of gethostname()
  408.          because the two aren't guarenteed to be the same name for the
  409.          same host: on some losing systems, one is a FQDN and the other
  410.          is not.  Here in the wide wonderful world of Unix it's rocket
  411.          science to obtain the local hostname in a portable fashion.
  412.          
  413.          And don't forget, gethostbyname() reuses the structure it
  414.          returns, so we have to copy the fucker before calling it
  415.          again.
  416.  
  417.          Thank you master, may I have another.
  418.          */
  419.           struct hostent *h = gethostbyname (dpyname);
  420.           if (!h)
  421.         DEVICE_ON_CONSOLE_P (d) = 0;
  422.           else
  423.         {
  424.           char hn [255];
  425.           struct hostent *l;
  426.           strcpy (hn, h->h_name);
  427.           l = gethostbyname (localname);
  428.           DEVICE_ON_CONSOLE_P (d) = (l && !(strcmp (l->h_name, hn)));
  429.         }
  430.         }
  431.       start_interrupts ();
  432.     }
  433.     }
  434. #endif /* HAVE_X_WINDOWS */
  435. }
  436.  
  437. #endif /* HAVE_NATIVE_SOUND */
  438.  
  439. void
  440. init_device_sound (struct device *d)
  441. {
  442. #ifdef HAVE_NAS_SOUND
  443.   init_nas_sound (d);
  444. #endif
  445.  
  446. #ifdef HAVE_NATIVE_SOUND
  447.   init_native_sound (d);
  448. #endif
  449. }
  450.  
  451. void
  452. syms_of_sound (void)
  453. {
  454.   defkeyword (&Q_volume,   ":volume");
  455.   defkeyword (&Q_pitch,    ":pitch");
  456.   defkeyword (&Q_duration, ":duration");
  457.   defkeyword (&Q_sound,    ":sound");
  458.  
  459. #ifdef HAVE_NAS_SOUND
  460.   defsymbol (&Qnas, "nas");
  461. #endif
  462.  
  463.   defsubr (&Splay_sound_file);
  464.   defsubr (&Splay_sound);
  465.   defsubr (&Sding);
  466.   defsubr (&Swait_for_sounds);
  467.   defsubr (&Sconnected_to_nas_p);
  468. }
  469.  
  470.  
  471. void
  472. vars_of_sound (void)
  473. {
  474. #ifdef HAVE_NATIVE_SOUND
  475.   Fprovide (intern ("native-sound"));
  476. #endif
  477. #ifdef HAVE_NAS_SOUND
  478.   Fprovide (intern ("nas-sound"));
  479. #endif
  480.  
  481.   DEFVAR_INT ("bell-volume", &bell_volume, "*How loud to be, from 0 to 100.");
  482.   bell_volume = 50;
  483.  
  484.   DEFVAR_LISP ("sound-alist", &Vsound_alist,
  485.     "An alist associating names with sounds.\n\
  486. When `beep' or `ding' is called with one of the name symbols, the associated\n\
  487. sound will be generated instead of the standard beep.\n\
  488. \n\
  489. Each element of `sound-alist' is a list describing a sound.\n\
  490. The first element of the list is the name of the sound being defined.\n\
  491. Subsequent elements of the list are alternating keyword/value pairs:\n\
  492. \n\
  493.    Keyword:    Value:\n\
  494.    -------    -----\n\
  495.    sound    A string of raw sound data, or the name of another sound to\n\
  496.         play.   The symbol `t' here means use the default X beep.\n\
  497.    volume    An integer from 0-100, defaulting to `bell-volume'\n\
  498.    pitch    If using the default X beep, the pitch (Hz) to generate.\n\
  499.    duration    If using the default X beep, the duration (milliseconds).\n\
  500. \n\
  501. For compatibility, elements of `sound-alist' may also be:\n\
  502. \n\
  503.    ( sound-name . <sound> )\n\
  504.    ( sound-name <volume> <sound> )\n\
  505. \n\
  506. You should probably add things to this list by calling the function\n\
  507. load-sound-file.\n\
  508. \n\
  509. Caveats:\n\
  510.  - You can only play audio data if running on the console screen of a\n\
  511.    Sun SparcStation, SGI, or HP9000s700.\n\
  512. \n\
  513.  - The pitch, duration, and volume options are available everywhere, but\n\
  514.    many X servers ignore the `pitch' option.\n\
  515. \n\
  516. The following beep-types are used by emacs itself:\n\
  517. \n\
  518.     auto-save-error    when an auto-save does not succeed\n\
  519.     command-error    when the emacs command loop catches an error\n\
  520.     undefined-key    when you type a key that is undefined\n\
  521.     undefined-click    when you use an undefined mouse-click combination\n\
  522.     no-completion    during completing-read\n\
  523.     y-or-n-p        when you type something other than 'y' or 'n'\n\
  524.     yes-or-no-p      when you type something other than 'yes' or 'no'\n\
  525.     default        used when nothing else is appropriate.\n\
  526. \n\
  527. Other lisp packages may use other beep types, but these are the ones that\n\
  528. the C kernel of Emacs uses.");
  529.   Vsound_alist = Qnil;
  530.  
  531.   DEFVAR_LISP ("synchronous-sounds", &Vsynchronous_sounds,
  532.            "Play sounds synchronously, if non-nil.\n\
  533. Only applies if NAS is used and supports asynchronous playing\n\
  534. of sounds.  Otherwise, sounds are always played synchronously.");
  535.   Vsynchronous_sounds = Qnil;
  536.  
  537.   DEFVAR_LISP ("native-sound-only-on-console", &Vnative_sound_only_on_console,
  538.            "Non-nil value means play sounds only if XEmacs is running \
  539. on the system console.\n\
  540. Nil means always always play sounds, even if running on a non-console tty\n\
  541. or a secondary X display.\n\
  542. \n\
  543. This variable only applies to native sound support.");
  544.   Vnative_sound_only_on_console = Qt;
  545.  
  546. #if defined (HAVE_NATIVE_SOUND) && defined (hp9000s800)
  547.   vars_of_hpplay ();
  548. #endif
  549. }
  550.